perm filename SCORE.F4[IRC,LCS] blob
sn#273046 filedate 1977-03-30 generic text, type T, neo UTF8
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C 7/74 ********** SCORE ********** LELAND SMITH, SEP.1969
C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
C GENERATION PROGRAM.
C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C LOAD 'S1' WITH S2,S3,SCANZ,RAND AND SPRINT
C (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON /INS/ INST(27),BG(60)
C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
1 LN,ITYP,TPALN(4),JED
CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
C SEE LABEL 1774 AND ABOVE RE. BUFFER LIMIT.
COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
1 ,P1(27),JFM(4),COPY(30),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
DIMENSION LIST(78),JNP(80)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C /C/=26
EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/2000/
1, JFM(3)/','/
C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
DATA IBLA/' '/,IXX/'X'/
1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
LPAR=0
IPRN=0
QX=0.
MOT=0
RETRO=-1.
INVRT=-1
ICON=-1
LCNT=1
PARENS=0
JZ=1
CALL RNDINT
C INIT RAND NUM GENERATOR.
CC PR=0
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
QTS=-1.
KB=0
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
INST(K)=0
CNT(K)=0
RDEV(K)=0
C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
NP(K)=0
IQ(K)=0
C IQ IS FOR RESTART FLAG
IPT(K,1)=0
DO 1128 L=1,32
1128 PCH(K,L)=0
ITYP=-1
C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C SECONDS TO BE OMITTED, DUR AT CUTOFF.
JED=-1
2112 TYPE 8002
1112 ACCEPT 77732,JNP
JFM(4)='5F)'
JFM(1)=' (A'
C FOR FREE 'A' FORMAT
CALL FMT(JFM,JNP,MLX)
REREAD JFM,K,TF,AMPFAC,OP1,DURX
C JFM IS THE CURRENT FORMAT STATEMENT
IF(K.NE.'EDIT')GO TO 3112
JED=0
GO TO 2112
C 'E(DIT)' GOES TO EDIT MODE
3112 IF(TF.EQ.0)TF=1.
IF(AMPFAC.EQ.0)AMPFAC=1.
21122 IF(K.NE.'TYPE')GO TO 128
ITYP=0
DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
IFLNM='FOR21'
REWIND 21
GO TO 3127
8001 FORMAT(A5,5F)
77732 FORMAT(80A1)
300 FORMAT(I,3F)
128 IF(K.EQ.'INFO')GO TO 1280
IF(K.NE.'HELP')GO TO 3128
1280 TYPE 8002
TYPE 1113
TYPE 118
TYPE 1114
TYPE 8002
GO TO 1112
118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC*** TEMPORARY ***8002 FORMAT(' TYPE FILE NAME'/)
8002 FORMAT(' TYPE FILE NAME-- '$)
1113 FORMAT(' NAME TF AMPFAC OMIT" DUR"'/)
1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
3128 IF(K.NE.IBLA)IFLNM=K
CALL IFILE(1,IFLNM)
READ(1,300)LN,IXIN
C CHECK FOR LINE NUMBERS ONLY.
REREAD 8001,K
IF(K.NE.'COMME')GO TO 3000
3001 READ(1,77732)JNP
IF(JNP(3).NE.ISEMI)GO TO 3001
GO TO 3127
C TO READ HEADER OF 'ET' FILES
3000 REWIND 1
CALL IFILE(1,IFLNM)
CC3127 ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
3127 ISLAC=IFLNM
C NOW USES MY FORNAM SUBROUTINE TO PUT EXTENSION .SCR ON OUTPUT
5127 TYPE 118
IF(DURX.EQ.0)DURX=19999.
IXIN=1
INONLY=-1
ACCEPT 300,MX,X,Y,Z
IF(MX.NE.99)GO TO 6127
TYPE FINM
ACCEPT 8001,ISLAC
GO TO 5127
6127 IF(Z.NE.0)INONLY=Z
IF(X.NE.0)IXIN=X
C MX=3 GIVES DURS ONLY
C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
MZ=0
JOUT=5
C 5=OUTPUT TO TTY
SOS=-1.
IF(Y.NE.0)SOS=0
C IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
IF(MX.NE.22)GO TO 2107
CC JOUT=3
C DIRECT TO LPT AT COLGATE 6/74
JOUT=22
REWIND 22
2107 IF(MX.LE.1)MX=MX-2
IF(MX.EQ.-2)GO TO 77
IF(MX.EQ.2)GO TO 77
IF(MX.NE.22)GO TO 177
77 MZ=-1
177 IF(MX.EQ.4)MZ=-4
CALL READIT
END
SUBROUTINE READIT
COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
1 LN,ITYP,TPALN(4),JED
CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
COMMON/VV/LIMIT, V(1) /A/ ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
1 ,P1(27),JFM(4),COPY(30),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
DIMENSION IV(1),LIST(78),JNP(80)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C /C/=26
EQUIVALENCE (VX1,VX(1)),(JNP,INP1,INP(1)),(IPP,ISCA(2))
1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
C *************** READS INPUT ***********************
KIMIT=LIMIT-100
C FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
2308 IF(ITYP)GO TO 2127
DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
1,TEDIT/20H(' RETYPE LINE?'/ )/,IEN/'N'/,ITMPO/'TEMPO'/
23081 TYPE TINST
ACCEPT 77732,JNP
77732 FORMAT(80A1)
CC IF(JED)WRITE(21,77732)INP
IF(JED)CALL COLTTY(JNP,21)
JFM(4)='80A1)'
C PUTS ON LPT AND TTY
GO TO 1074
CC 6/74 COLGATE2127 JREAD=1
CC 6/74 COLGATE 4400 READ(1,77732,END=2337)JNP
2127 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
CC SEE END OF PG.6 IF(SOS)WRITE(JOUT,87732)INP
CC 7/74 IF(SOS)CALL COLTTY(JNP,JOUT,3)
CC 6/74 COLGATE GO TO(441,442,443,444,445,446)JREAD
441 JFM(4)='80A1)'
IF(LN.EQ.0)GO TO 1074
CC REREAD 2114,LN,JNP
C**** READS ONLY FILES WITH LINE NUMBERS!
JFM(1)=' (I,A'
CALL FMT(JFM,JNP,MLX)
REREAD JFM,LN,J,JNP
GO TO 4127
1074 JFM(1)=' (A'
CALL FMT(JFM,JNP,MLX)
REREAD JFM,J,JNP
4127 IF(JED)GO TO 41271
IF(K.EQ.'Y')GO TO 41271
C K CHECK IS TO PASS AFTER RETYPING
TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'Y')GO TO 23081
IF(K.EQ.IG)JED=-1
41271 IF(J.EQ.IBLA)GO TO 2308
MLX=1
IZ=0
JA=-1
ISUB=4
CALL CLEAN(INP,LEND)
C CLEANS OUT = AND , AND FINDS LINE LENGTH.
ALL=1.
VX1=0
VX2=0
VX3=0
LK=-1
K=0
IF(V(I-1).NE.-9900.-BY)GO TO 364
BY=-1.
I=I-1
364 DO 361 JD=1,LEND
N=INP(JD)
IF(N.NE.'R')GO TO 361
C LOOKS FOR 'RESTART'
DO 3611 M=JD,LEND
KL=INP(M)
IF(KL.EQ.IBLA)GO TO 3631
IF(KL.EQ.ISEMI)GO TO 3631
CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
3611 INP(M)=IBLA
C CHANGES 'RESTART' TO BLANKS
3631 DO 363 N=1,NINS
IF(J.NE.INST(N))GO TO 363
IQ(N)=-1
C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
GO TO 362
363 CONTINUE
361 IF(N.EQ.ISEMI)GO TO 6773
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J)GO TO 6773
IF(IQ(K).EQ.-1)GO TO 6773
C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
LK=K
GO TO 1773
36 IF(J.EQ.'RUN;')GO TO 197
IF(J.NE.'RUN')GO TO 97
197 CALL RUNIT
97 IF(J.EQ.'INSER')GO TO 397
IF(J.NE.'EDIT')GO TO 297
397 ISUB=6
297 IF(ISUB.GT.4)GO TO 1773
IF(J.EQ.ITMPO)GO TO 1773
IF(J.EQ.'CONDU')GO TO 1773
IF(J.EQ.'PLAY')GO TO 1773
IF(J.EQ.'SECTI')GO TO 1081
C****************** ABOVE AND BELOW FOR 'SECTIONS'
IF(J.EQ.'END')GO TO 1082
IF(J.EQ.'END S')GO TO 1082
IF(J.EQ.'FINIS')GO TO 1082
362 LK=NINS+1
IF(LK.GT.KZY)CALL ERR(LN)
INST(LK)=J
IZ=LK
GO TO 1773
C*********** DOWN TO 8001 FOR 'SECTIONS'
1083 V(I)=-99.
KL=1
GO TO 3083
C READS 'PLAY SECT. N1,N2'
1081 V(I)=-199.
KL=4
3083 DO 2081 K=KL,72
C****** OR 80 ↑↑↑↑↑↑↑↑↑ ?????
IF(INP(K).EQ.IBLA)GO TO 2081
IV(I+1)=INP(K)
I=I+2
3081 BY=-1.
GO TO 2308
2081 CONTINUE
C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
C********* FEB 15,71
1082 V(I)=-299.
I=I+1
GO TO 3081
C MARKS END OF SECTION
C************************
8001 FORMAT(A5,5F)
107 FORMAT(I,A5,5F)
4 IF(LK.LE.NINS)GO TO 8773
IF(ALL.GT.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(LK)=VX1
IDALL=LK
GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004 BG(LK)=VX1
IF(LK.EQ.IZ)VX1=0
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004 NINS=LK
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(LK)=VX2
GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
900 IF(VX1.NE.BY)GO TO 497
IF(J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
497 BY=VX1
C BY=CURRENT BG TIME.
V(I)=-9900.-BY
I=I+1
IF(NWZ.NE.0)CALL BGSORT(BY)
5773 IF(J.EQ.ITMPO)GO TO 1106
IF(J.EQ.'CONDU')GO TO 3018
IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'
4773 NW=LPAR
CZZZZZZZ MLX=ML
ML=MLX
IF(I.LT.KIMIT)GO TO 774
TYPE 107,I
IF(I.GE.LIMIT)TYPE 1774
1774 FORMAT(/' ******* TOO MUCH INPUT DATA!! *******'/)
774 ALL=1.
DF=0
ISUB=1
CXXX IF(MLX.LT.LEND)GO TO 17732
CXXX THIS LOST ON );Px . . . ; TAKEN OUT 8/20/76
CXXX GO TO 7773
CZZZZZZZZZZZZZZZZZZZZZZZZ
1299 IF(MLX.LE.LEND)GO TO 1773
CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
7773 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
IF(INP1.EQ.IBLA)GO TO 7773
IF(JED)GO TO 77733
TYPE TEDIT
ACCEPT 77732,K
IF(K.NE.'Y')GO TO 442
TYPE TPALN
ACCEPT 77732,JNP
442 IF(K.EQ.IG)JED=-1
C DOESN'T WORK FOR EDITS AND INSERTS YET???
77733 MLX=1
C FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
CALL CLEAN(INP,LEND)
1773 IF(IPRN.EQ.0)GO TO 17732
L=I-1
IF(QTS.GE.0)GO TO 597
IF(V(I-1).EQ.999.)L=L-1
597 IPRN=IPRN-1
IF(PARENS.EQ.0)GO TO 17733
PARENS=0
LIST(LCNT+2)=L
LCNT=LCNT+3
IF(IPRN.EQ.0)GO TO 17732
IPRN=0
17733 LIST(MOT)=L
MOT=0
C FOR ERROR TRAP
CC17732 JZ=0
17732 N=0
17731 ML=MLX
C BIG LOOP -- TO END OF PAGE 1.
JD=ML
975 N=INP(JD)
IF(N.EQ.IBLA)GO TO 236
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
33611 IF(N.EQ.'(')GO TO 697
IF(N.NE.')')GO TO 2361
697 INP(JD)=IBLA
L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.')')GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
IF(MOT.NE.0)CALL ERR(3)
MOT=LCNT-1
1140 DO 11401 JC=1,LCNT-1,3
IF(INP(L).NE.LIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
TYPE 11402,INP(L)
CALL EXIT
11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
11401 CONTINUE
LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
LIST(LCNT+1)=I
GO TO 236
C ''''''' FOR SINGLE QUOTES
3361 IPRN=IPRN+1
GO TO 236
C JUMPS BACK INTO QUOTE SECTION
CQ IF(PARENS.EQ.0)GO TO 2140
CQ LIST(LCNT+2)=L
CQ LCNT=LCNT+3
CQ PARENS=0
CQ GO TO 33612
CQ2140 LIST(MOT)=L
CQ GO TO 33612
CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC.
2361 IF(N.NE.'@')GO TO 5361
DO 113 L=1,LEND
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.'-')GO TO 6113
RETRO=0
INP(K)=IBLA
GO TO 113
6113 IF(JG.NE.'$')GO TO 7113
C '$' IS FOR INVERSIONS IN 'NOTES'
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 JMOT=1,LCNT,3
IF(JG.NE.LIST(JMOT))GO TO 6361
VX1=0
DO 40 M=JD+2,LEND
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
CCZZZ IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
IF(JG.EQ.KSLA)GO TO 140
IF(JG.EQ.ISEMI)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
INP(K)=IBLA
CALL SCANR
JA=JC
140 JC=1
KN=LIST(JMOT+1)
M=LIST(JMOT+2)+1
IF(RETRO)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT)GO TO 940
840 X=V(KN)
V(I)=X+VX1
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
KN=KN+JC
IF(V(KN-JC).NE.85.)GO TO 940
V(I-1)=85.
GO TO 840
940 Z=V(KN)
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.85.)GO TO 540
Y=0
IF(INVRT.EQ.0)Y=(X-Z)*2.
V(I)=Z+VX1+Y
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
DO 8361 L=JD,LEND
JG=INP(L)
C PUT IN NOV 25, 72
CCZZZ IF(JG.EQ.ISEMI)GO TO 93612
KN=L
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.')')IPRN=IPRN+1
IF(JG.NE.ISEMI)GO TO 8361
IAMP=-1
GO TO 9361
8361 CONTINUE
C ABOVE 4 LINES PUT IN 8/76. REPLACE C*********** ↓↓
CCZZZ8361 IF(JG.EQ.'*')IAMP=-1
C***********8361 IF(JG.EQ.ISEMI)IAMP=-1
C*********** MLX=LEND
C ↑↑↑↑↑↑↑ 6/75
C************ GO TO 93612
9361 MLX=L+1
IF(L.GE.LEND)GO TO 93612
C************9361 MLX=L
C************ IF(L.EQ.LEND)GO TO 93612
C ↑↑↑↑↑↑↑ 6/75
C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
IF(IAMP.NE.0)GO TO 797
IF(QTS)GO TO 1773
C GO BACK IF NOT END OF LINE
797 JZ=-1
93612 IF(IAMP.EQ.0)GO TO 93611
C NOV 25, 72
IF(QTS)GO TO 3013
GO TO 2722
C THESE ARE FOR "LIT" ITEMS
C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
CCZZZ93611 IF(JG.EQ.ISEMI)GO TO 7773
93611 IF(KN.EQ.LEND)GO TO 7773
JZ=0
IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
GO TO 236
C LAST TIME FOR QUOTES
C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
C JUMPS TO END STRING OF QUOTES
6361 CONTINUE
CALL ERR(LN)
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.EQ.'$')CALL ERR(LN)
C FOUND $ BUT NO @!
IF(N.NE.ID)GO TO 53611
IF(ISUB.NE.1)GO TO 53611
IF(INP(JD+1).NE.IF)GO TO 236
C JUMP IF NOT DUTY FACTOR
DF=DF-100.
GO TO 43615
53611 IF(N.NE.ISS)GO TO 53612
IF(INP(JD+1).NE.'U')GO TO 53612
DF=DF-200
C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
GO TO 43615
53612 IF(N.NE.IAA)GO TO 43611
C FINDS 'ALL'.
IF(INP(JD+1).NE.'L')GO TO 236
ALL=-1.
GO TO 43615
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
C BEFORE! QUAD (IF USED).
C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611 IF(N.NE.'Q')GO TO 4361
IF(INP(JD+1).NE.'U')GO TO 4361
QX=-13.
DO 43612 N=JD,LEND
J=INP(N)
IF(J.EQ.IXX)QX=QX-1.
IF(J.EQ.IF)QX=QX-2.
IF(J.EQ.IBLA)GO TO 236
IF(J.EQ.KSLA)GO TO 236
CCZZZ IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43612 INP(N)=IBLA
4361 IF(N.NE.'I')GO TO 43613
IF(ISUB.NE.4)GO TO 43613
C -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
C -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
C THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
L=-1
N=INP(JD+1)
IF(N.EQ.IE)L=L-1
INVIS(LK)=L
43615 DO 43614 L=JD,LEND
N=INP(L)
CC IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
IF(N.EQ.IBLA)GO TO 236
IF(N.EQ.ISEMI)GO TO 236
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614 INP(L)=IBLA
CC43613 IF(N.NE.KSLA)GO TO 636
43613 IF(N.NE.KSLA)GO TO 1336
CC JZ=-1
IF(JD.GE.LEND-1)JZ=0
C SO IT WILL READ NEXT LINE.
CZZZZZZZZZZZZZZZ INP(JD)=ISEMI
GO TO 336
CCZZZ436 IF(INP(MLX).NE.IBLA)GO TO 336
CCZZZ MLX=MLX+1
CCZZZ GO TO 436
CC636 IF(JD.LT.LEND)GO TO 1336
CC ICON=0
CC GO TO 77731
CC GO TO 7773
C TO CONTINUE ON NEXT LINE.
CCZZZ636 IF(N.NE.ISEMI)GO TO 936
1336 IF(N.NE.ISEMI)GO TO 936
IAMP=-1
CC IF(ISUB.NE.1)IAMP=-1
336 MLX=JD+1
IF(ISUB.GE.104)GO TO 104
IF(ISUB.GT.3)GO TO 1899
GO TO (101,102,103),ISUB
C PAR MOV LIST OTHERS
CCZZZ936 IF(N.NE.IDOT)GO TO 736
936 IF(N.NE.IDOT)GO TO 136
L=INP(JD+1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
IF(CODE.EQ.-22.)INP(JD)=1
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
CCZZZ736 IF(N.NE.'*')GO TO 136
CCZZZ IAMP=-1
CCZZZ INP(JD)=IBLA
CCZZZ GO TO 336
136 IF(N.NE.IQT)GO TO 236
DO 1361 K=JD+1,LEND
IF(INP(K).NE.IQT)GO TO 1361
JD=K+1
GO TO 975
C SKIPS MATERIAL IN QUOTES
1361 CONTINUE
CALL ERR(LN)
C OPEN QUOTES
236 JD=JD+1
IF(JD.LE.LEND)GO TO 975
CALL ERR(1)
1899 CALL SCANR
CZZZZZZZ ML=MLX
CZZZZZZZZZZZZZZZZZZZZZZZZZZ
GO TO(1,2,3,4,5,6),ISUB
101 N=INP(ML)
IZ=ML
ML=ML+1
IF(N.EQ.IBLA)GO TO 101
C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
JA=-1
IF(N.EQ.IPP)GO TO 1
IF(N.EQ.IE)GO TO 2308
IF(N.EQ.'R')CALL RUNIT
C 'RUN' MAY REPLACE 'END' FOR LAST INST.
IF(N.EQ.ID)GO TO 7720
CALL ERR(LN)
1 CALL SCANR
LPAR=VX1
IJ=LPAR
IF(QX.GE.0)GO TO 5703
IJ=LPAR+4
C SETS UP PARAM FOR QUAD CALL
V(I)=IJ+LK*10000
V(I+1)=2*ALL
C TEST "ALL" FEATURE HERE!!!!!!!
C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
V(I+2)=QX
I=I+3
QX=0.
5703 IAMP=0
IF(IJ.LE.NP(LK))GO TO 897
IF(IJ.LT.31)NP(LK)=IJ
897 IF(LPAR.EQ.32)LPAR=1
V(I)=LPAR+LK*10000
C +1=WDCNT, +2=CODE, +3='NM' CCCCC
IJ=I+1
I=I+4
ITMP=0
CODE=0
NFLG=1
ML=IZ+M
C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
C QU=QUADC QUX=QUADX
5702 ML=ML+1
CC IF(ML.GT.72)GO TO 99
N=INP(ML)
IF(N.EQ.IBLA)GO TO 5702
IF(N.EQ.',')GO TO 5702
NL=INP(ML+1)
JA=-1
ISUB=0
IF(N.EQ.IXX)GO TO 2703
IF(N.EQ.'R')GO TO 6702
IF(N.EQ.IF)GO TO 8702
IF(N.EQ.IPP)GO TO 7006
IF(N.NE.'C')GO TO 4005
IF(NL.EQ.'U')GO TO 7006
C FOR 'CUTOFF'
4005 JA=0
IF(N.EQ.IEN)GO TO 6005
IF(N.EQ.'M')GO TO 703
IF(N.EQ.'L')GO TO 2720
IF(N.EQ.ISS)GO TO 6703
IF(N.EQ.ITT)GO TO 4018
IF(N.EQ.IQT)GO TO 5720
IF(N.EQ.ISEMI)GO TO 2018
C 7/75 IF(N.EQ.IPP)JA=-1
C FOR ;P5 P3;
7006 CALL SCANR
IF(ISUB.EQ.8)GO TO 8
I=I+JJ
V(IJ+1)=NNUM+DF
IF(JJ.EQ.1)GO TO 4006
C IF NNUM IS '-2' THEN NOTES ARE PRINTED
IF(NNUM.NE.-2)GO TO 5006
IX=IJ+3
DO 2006 K=2,JJ,3
2006 CALL RANR(VX,K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5006 IX=IJ+2
DO 6006 K=1,JJ
6006 V(IX+K)=VX(K)
IF(NL.EQ.'U')GO TO 8006
V(IX+JJ-2)=1.
C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
GO TO 3013
4006 IF(JA)VX1=VX1/100.+9999.
C CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
V(I-1)=VX1
GO TO 3013
8006 V(IJ+1)=-19
C FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
GO TO 3013
6702 IF(NL.EQ.IE)GO TO 2703
C JUMP IF "REP"
IF(NL.EQ.ITT)GO TO 4018
C JUMP IF "RTAP"
CODE=-22
IF(NL.EQ.'L')CODE=-46.0
C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
IF(NL.NE.IEN)GO TO 1016
C JUMP IF NOT "RNOTES"
JA=0
C FOR SCANR
CODE=-36.
GO TO 1016
6005 CODE=-33
IF(NL.EQ.'A')GO TO 2720
C NUMS, NOTES, NAMES.
IF(NL.NE.'U')GO TO 1016
CODE=-44.
1610 JA=-1
GO TO 1016
8702 CODE=-35
IF(NL.EQ.'U')GO TO 1016
ML=ML+1
CALL SCANR
7 V(IJ+1)=CODE+DF
V(IJ+2)=1.
IF(VX1.GT.15)CALL ERR(4)
C TRAPS F NUMS >15.
V(I)=VX1+85.
GO TO 7703
C******** MOVE IS NEXT ***********
703 BW=V(IJ-2)
IC=0
CC DO 7031 K=ML+1,72
DO 7031 K=ML+1,LEND
LP=INP(K)
IF(LP.EQ.KSLA)GO TO 8031
CC IF(INP(K).EQ.ISEMI)GO TO 8031
IF(LP.EQ.IPP)IC=1
C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
7031 IF(LP.EQ.IXX)IC=-1
C IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
8031 I=I-1
V(I)=0
X=-9900.-BY
IF(BY.EQ.0)X=-9900.-BG(LK)
IF(BW.EQ.X)GO TO 8005
IF(BW.NE.-9900.-BY)GO TO 1102
V(IJ-2)=X
GO TO 8005
1102 V(IJ)=V(IJ-1)
V(IJ-1)=X
IJ=IJ+1
I=I+1
8005 LP=IJ-1
BW=-9900.-X
ISUB=2
IZ=-1
C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703 GO TO 1299
102 IF(IZ.LT.0)GO TO 2102
C SKIPS NEXT FIRST TIME
BW=V(ICT)+BW
V(I)=-9900.-BW
V(I+1)=V(LP)
V(I+2)=(JJ+2)*ALL
V(I+3)=CODE+DF
I=I+4
IZ=1
2102 IF(BW.LT.10000.)CALL BGSORT(BW)
C ROUND-OFF NONSENSE
2 VX3=-9900.
VX2=VX3
CALL SCANR
IF(JJ.GT.0)GO TO 5102
JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
DO 6102 K=1,JJ
6102 VX(K)=VX(K+20)
GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102 IF(JJ.EQ.4)CALL ERR(LN)
C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
IF(VX3.NE.-9900.)GO TO 3102
IF(VX2.NE.-9900.)GO TO 4102
VX2=VX1
VX1=10000.
4102 VX3=VX2
JJ=3
C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102 IF(IZ.GE.0)GO TO 3006
V(IJ)=(JJ+2)*ALL
C WORD COUNT
CODE=-55.
IF(JJ.NE.3)CODE=-57.
IF(NFLG)CODE=CODE-1.
IF(IC)CODE=-59.
C CODE=-56 OR -58 FOR NOTES.
V(IJ+1)=CODE+DF
IZ=0
3006 IF(NFLG.EQ.1)GO TO 5005
CALL RANR(VX,2)
IF(JJ.NE.3)CALL RANR(VX,4)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5005 IF(IC.LE.0)GO TO 3003
C NEXT FOR 'MOVP', MOVE FROM PARAM TO PARAM.
DO 1003 K=2,JJ
1003 VX(K)=VX(K)/100.0+9999.0
C CHANGES PARAM NUMS TO MAGIC NUMS.
3003 ICT=I
ILIT=JJ
C SAVES FOR SLASH REPEAT FEATURE
IJ=IJ+1
DO 1006 K=1,JJ
VX(20+K)=VX(K)
C SAVES FOR SLASH REPEAT FEATURE
1006 V(IJ+K)=VX(K)
I=I+JJ
IJ=I+2
IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
V(I)=-9900.-BY
GO TO 8703
7703 V(IJ)=4.*ALL
8703 I=I+1
GO TO 4773
C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
6703 CODE=-12.
IF(INP(ML+3).EQ.'L')CODE=-11.
V(IJ)=2.*ALL
V(IJ+1)=CODE+DF
I=I-1
GO TO 4773
4018 CNT(LK)=-9900.-BY
P(LK)=V(I-4)
CC 6/74 COLGATE JREAD=3
CC 6/74 COLGATE GO TO 4400
1444 IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
IF(J.EQ.'CONDU')GO TO 444
IF(NL.NE.ITT)GO TO 2338
CODE=-23.
GO TO 1016
2338 I=I-4
GO TO 4773
3018 CNT(KZY)=-9900.
GO TO 1444
444 P(KZY)=980000.
GO TO 2308
C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C 'REP'
2703 ML=ML+1
VX1=0
VX2=0
VX3=0
IF(N.EQ.IXX)GO TO 2704
INP(ML)=IBLA
INP(ML+1)=IBLA
C WIPES OUT 'EP' IN 'REP'
2704 CALL SCANR
V(IJ)=3.
V(IJ+1)=-66.0
IF(VX1.EQ.32.)VX1=1.
IF(VX1.EQ.0)VX1=LPAR
IF(VX2.EQ.0)VX2=LK-1
V(IJ+2)=VX1+VX2*10000.
KL=VX2
IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
IF(VX3.EQ.0)GO TO 4773
L=VX3
ML=LK+1
DO 1018 KL=ML,L
IF(LPAR.LE.NP(KL))GO TO 997
IF(LPAR.LT.31)NP(KL)=LPAR
997 IF(DUR(KL))DUR(KL)=DUR(LK)
C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
V(I)=V(I-4)+10000.
V(I+1)=3.
V(I+2)=-66.
V(I+3)=V(I-1)
1018 I=I+4
GO TO 4773
2018 IF(DF.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
V(IJ+1)=-201.
V(IJ+2)=1.
V(IJ+3)=0
GO TO 7703
20181 V(IJ)=3.
V(IJ+1)=-66.
V(IJ+2)=NW+LK*10000
GO TO 4773
C READS /P5 .3 "ABC" .7 "XYZ"/
8 V(IJ+1)=-77.+DF
C DF HAS SUBR CALL INFO
I=I+1
VX(JJ-1)=1
C FOR RAND. SINGLE LITS.
DO 3722 K=1,JJ,2
V(I)=VX(K)
3722 I=I+1
V(IJ+2)=JJ/2
V(IJ+3)=I
DO 4722 K=2,JJ,2
KN=I
I=I+1
L=VX(K)
DO 6722 KL=L,LEND
IF(INP(KL).EQ.IQT)GO TO 4722
IV(I)=INP(KL)
6722 I=I+1
4722 V(KN)=I-KN-1
V(IJ)=(I-IJ)*ALL
GO TO 4773
2720 QTS=0
ISUB=104
IF(NL.EQ.'A')ISUB=ISUB+1
GO TO 1299
104 KL=0
DO 6721 K=ML,LEND
L=INP(K)
IF(L.EQ.IBLA)GO TO 6721
JC=K+1
IF(L.EQ.IQT)GO TO 7721
IF(L.EQ.KSLA)GO TO 7232
IF(L.EQ.ISEMI)GO TO 7232
IF(L.EQ.'%')INP(K)=KSLA
IF(L.EQ.'?')INP(K)=ISEMI
IF(L.EQ.'!')INP(K)=','
IF(KL.EQ.0)KL=K
6721 CONTINUE
C FOR REPEAT OF ITEM BY SLASH
C KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
7232 IF(KL.EQ.0)GO TO 7233
JC=KL
ML=K+1
JD=K-1
NLIT=K-KL
GO TO 8721
7233 DO 7230 KL=ILIT,ILIT+NLIT
V(I)=V(KL)
7230 I=I+1
GO TO 27222
7231 CONTINUE
5720 IAMP=-1
JC=ML+1
C FOR SINGLE 'LIT' ITEMS.
7721 DO 1722 KL=JC+1,LEND
IF(INP(KL).NE.IQT)GO TO 1722
JD=KL-1
ML=KL+1
NLIT=KL-JC
C EXTENT OF LIT ITEM IS FOUND
GO TO 8721
1722 CONTINUE
C CAN'T USE SLASH FOR REPEAT AFTER @Q
8721 V(I)=NLIT
ILIT=I
DO 9721 K=JC,JD
C PUTS ITEM IN "IV" ARRAY
I=I+1
9721 IV(I)=INP(K)
I=I+1
27222 IF(IAMP.EQ.0)GO TO 1299
2722 V(I)=999.
QTS=-1.
X=-88.
IF(ISUB.EQ.105)X=-89.
C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
27221 V(IJ+1)=X+DF
V(IJ)=(I-IJ+1)*ALL
IJ=IJ+2
V(IJ)=IJ+1
I=I+1
ISUB=1
GO TO 1299
7720 V(I)=LK
V(I+1)=3.
V(I+2)=-67.
ML=ML+4
CALL SCANR
V(I+3)=VX1
I=I+4
L=VX1
IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
GO TO 4773
C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
142 FORMAT(I,15A5)
1301 FORMAT(15A5)
CCC2773 FORMAT(I,A5,72A1)
CC2114 FORMAT(I,80A1)
300 FORMAT(I,3F,A1)
301 FORMAT(3F,A1)
6 KB=KB+1
IF(JED.GT.0)JED=0
IF(J.EQ.'INSER')GO TO 1340
OTH(KB,1)=VX1*100000.+VX2*100.+VX3
GO TO 340
1340 X=VX1
IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
OTH(KB,1)=X
GO TO 1338
C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
C - BEGIN LINE WITH <,END WITH ;
C UP TO 75 CHARACTERS MAY BE TYPED.
340 IF(VX3.NE.2)GO TO 1338
IF(ITYP.GE.0)GO TO 449
CC JREAD=5
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
445 OTH(KB,3)=1.
IF(LN.EQ.0)GO TO 447
REREAD 300,K,OTH(KB,2)
GO TO 1447
447 REREAD 301,OTH(KB,2)
1447 IF(JED)GO TO 2308
3445 TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.IG)JED=-1
IF(J.EQ.'INSER')GO TO 3446
IF(K.NE.'Y')GO TO 2308
IF(JED)GO TO 2308
449 TYPE TPALN
ACCEPT 301,OTH(KB,2)
IF(JED)WRITE(21,301) OTH(KB,2)
GO TO 2308
1338 IF(ITYP.GE.0)GO TO 1449
CC JREAD=6
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))CALL RUNIT
C READS A LINE. IF END OF FILE, JUMPS.
446 IF(LN.EQ.0)GO TO 448
REREAD 142,K,(OTH(KB,JD),JD=2,16)
GO TO 1446
448 REREAD 1301,(OTH(KB,JD),JD=2,16)
1446 IF(JED)2446,3445,2446
3446 IF(K.NE.'Y')GO TO 2446
IF(JED)GO TO 2446
1449 TYPE TPALN
ACCEPT 1301,(OTH(KB,JD),JD=2,16)
IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446 X=OTH(KB,2)
IF(J.NE.'INSER')GO TO 971
IF(VX3.EQ.0)GO TO 971
IF(X.NE.'*')GO TO 6
971 IF(X.EQ.'*')KB=KB-1
C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C LAST LINE HAS '*' IN COLUMN 1.
GO TO 2308
C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C INSERT MAY INCLUDE 10 CHARS(P3-P30),
C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C BX=INST N. Y=NOTE N. Z=PARAM N.
1106 KTMP=1
TP=60.
IAMP=0
BW=BY
ITMP=-1
ISUB=5
JA=-1
GO TO 2016
3019 V(I)=990000.00
V(I+1)=4.
V(I+2)=VX1
V(I+3)=VX2/TP
V(I+4)=VX3/TP
I=I+5
BY=BW
C SEPT 18, 70
IF(VX1.EQ.0)GO TO 2308
BW=BW+VX1
V(I)=-9900.-BW
I=I+1
CALL BGSORT(BW)
9003 IF(IAMP)GO TO 4003
2016 VX3=0
VX2=0
GO TO 1299
5 IF(VX2.NE.0)GO TO 105
C 'TEMPO/120;' OR 'TEMPO/1.5 72;' IS OK.
VX2=VX1
VX1=0
105 IF(VX3.EQ.0)VX3=VX2
IF(VX2.LT.11.)TP=1.
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=VX1
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX3
C PCH(1)=TIME (2)=MM1 (3)=MM2
KTMP=KTMP+1
IF(IAMP.EQ.0)GO TO 2016
4003 VX1=0
IAMP=0
VX2=VX3
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=0
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX2
C MM CAN BE FROM 11 UP TEMPO FACTOR FROM 10 DOWN.
C UP TO 30 TEMPO CHANGES MAY BE MADE.
1016 IA=I
IZ=1
3100 V(I-2)=CODE+DF
ISUB=3
5016 IF(IAMP.GE.0)GO TO 1299
117 IF(IZ-2)3013,9004,9004
103 K=INP(ML)
IF(K.EQ.ITT)GO TO 1106
IF(K.EQ.KSLA)GO TO 1014
IF(K.EQ.ISEMI)GO TO 1014
CZZZZZZZZZZZZ CC ZZZZZZZZZZZZ
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 103
3 IF(VX1.EQ.-99.)GO TO 4022
IF(CODE.EQ.-22.)GO TO 2017
IF(CODE.LT.-23)GO TO 17
IF(IZ/2*2.EQ.IZ)GO TO 17
C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017 IF(VX1.EQ.10000.)GO TO 17
VX1=4./VX1
IF(JJ.NE.1)GO TO 2014
V(I)=VX1
GO TO 114
1217 IF(VX1.EQ.10000.)GO TO 114
C FOR "FINE" IN LIST
V(I+1)=VX2
IF(CODE.EQ.-36.)CALL RANR(V,I)
2217 I=I+1
C SETS UP STRING OF RAND SELECTIONS
GO TO 114
3217 V(I)=V(I-2)
V(I+1)=RB
C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
2014 DO 9006 L=2,JJ
IF(VX(L).EQ.0)GO TO 17
9006 VX1=4./VX(L)+VX1
JJ=1
17 V(I)=VX1
IF(CODE.EQ.-46.)GO TO 1217
IF(CODE.EQ.-36.)GO TO 1217
IF(CODE.NE.-35)GO TO 972
IF(VX1.GT.15)CALL ERR(4)
C FINDS F NUM.>15!
C JUMP IF STRING OF RAND SELECS.
972 IF(JJ.EQ.1)GO TO 114
L=VX(JJ)-1
X=V(I)
NL=I+1
I=L+I
DO 1017 K=NL,I
1017 V(K)=X
C ADDS UP TOTAL OF NOTES IN SEQ.
IZ=IZ+L
GO TO 114
1014 IF(CODE.EQ.-46.)GO TO 3217
IF(CODE.EQ.-36.)GO TO 3217
V(I)=RB
C RB SAVES IT FOR SLASH REPEAT
114 RB=V(I)
I=I+1
IZ=IZ+1
GO TO 5016
4022 JC=VX2+.3
JD=VX3-.5
IF(JJ.EQ.2)JD=1
C********* MAY 19,71 ----MANY LINES ABOVE.
IZ=IZ+JC*JD
C JC=HOW MANY TIMES, JD=HOW MANY NOTES
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
2005 V(L)=V(L-JC)
1005 I=I+JC
RB=V(NL)
C RB SAVES DATA FOR SLASH REPEAT FEATURE.
GO TO 5016
9004 IF(ITMP.EQ.0)GO TO 3013
IZ=IZ-1
C***** JAN. 1974
KA=1
IC=1
K=0
J=1
Z=0
RC=0
9007 Y=PCH(3,IC)/TP
X=PCH(2,IC)/TP
Z=PCH(1,IC)
CALL SQYY(YY,X,Y,Z)
XT(1)=X
PR=RA
C75 RD=1
C75 RB=0
ZZ=Z
CALL ACCEL
IF(K.EQ.IZ)GO TO 3013
IF(RA.NE.10000.)GO TO 9007
C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
3013 X=I-IJ
V(IJ+2)=X-3.
V(IJ)=X*ALL
IF(CODE.NE.-35)GO TO 4773
M=IJ+3
C SETS NUMBERS FOR FUNCS.
DO 313 K=M,I-1
313 IF(V(K).LT.85.)V(K)=V(K)+85.
GO TO 4773
END
C SCORB.F4 2ND HALF OF SCORE.
SUBROUTINE RUNIT
COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
1 ,LN,ITYP,TPALN,JED
COMMON/VV/LIMIT, V(1) /A/ ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
1 ,P1(27),JFM(4),COPY(30),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
DIMENSION IV(1),IT(30),IOUT(70),JPT(837),NCNT(27,32)
1,COFF1(27),COFF2(27),RREST(27)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL,
1 KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,RD,
1 VIJ2
C /C/=26
EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3))
1 ,(IT,INP(28)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
1 ,(IFM4,IFM(4)),(COFF1,INP(58)),(COFF2,INP(85))
1 ,(RREST,INP(112))
DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
1 ,RCD/"575326135500/
C ↑↑↑↑↑↑↑↑↑↑↑ "←-1;" FOR RCDFLG.
PR=0
DO 9337 K=1,27
COFF1(K)=0
9337 RREST(K)=0
C ZEROS CUTOFF AND RAND REST STORAGE
2337 T=0
DO 1107 K=1,30
1107 PL(K)=1.
C 2/74--WAS AT 17300/1 SETS DEFAULT OUTPUT MODE TO 1.
IF(ITYP)GO TO 23371
END FILE 21
DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
TYPE ENFI
C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
23371 IF(SOS)WRITE(JOUT,902)
C WRITES A BLANK LINE
NWZZ=0
IAMP=0
IT3=0
K=1
IX=0
BG(NINS+1)=19999.
4011 IF(CNT(K))GO TO 5011
6011 IF(K.EQ.KZY)GO TO 4337
K=K+1
GO TO 4011
5011 L=V(I-1)/(-9900.)
IF(L.EQ.1)I=I-1
V(I)=CNT(K)
V(I+1)=P(K)
V(I+3)=-44.
I=I+5
IF(P(K).EQ.980000.)I=I-4
KL=I
REWIND 1
ICT=IPT(K,1)
CALL IFILE(1,ICT)
9011 L=I+6
READ(1,7011)(V(M),M=I,L)
C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
IF(V(L).EQ.999.)GO TO 8011
I=L+1
GO TO 9011
8011 IF(P(K).NE.980000.)GO TO 6337
DO 7337 K=L,I,-1
7337 IF(V(K).NE.999.)GO TO 8337
8337 I=K-1
V(I)=0
V(I+1)=V(K)
V(I+2)=V(K)
C K WAS I-1 ABOVE.
I=I+3
V(KL+1)=I-KL-1
C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
GO TO 4337
6337 DO 5337 M=I,L
KN=M
5337 IF(V(M).EQ.999.)GO TO 3337
3337 I=KN
KN=I-KL
V(KL-1)=KN
V(KL-3)=KN+3
GO TO 6011
7011 FORMAT(7F)
4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
V(I)=-19899.
PP1=0
T6=10000.
DO 2118 K=1,NINS
ROFF(K)=0
C********* FEB 17,71
M=NP(K)
IT(K)=0
IPT(K,31)=0
NCNT(K,31)=1
DO 2118 L=1,M
NCNT(K,L)=1
2118 IPT(K,L)=0
DO 5013 K=1,IXIN
5013 X=RAND(0.0,0.0)
REWIND 1
CC IF(MX)CALL OFILE(1,ISLAC)
IF(MX)CALL FORNAM(ISLAC,'SCR')
C NOW USES EXTENSION .SCR WHEN WRITING ON DSK (DEV. 1 ONLY!)
NW=1
NWX=0
TDUR=0
A=0
T2=1.
T4=1.
T5=0
J=1
MK=0
C IS THE ABOVE NEEDED?
IF(MX.NE.3)GO TO 40021
K=4
10023 N=AMOD(V(K),100.0)/-11.
C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
IF(N.EQ.2)GO TO 77
IF(N.EQ.3)GO TO 77
IF(N.NE.4)GO TO 10021
77 IF(V(K-2).LT.10000.)GO TO 10021
J=V(K+1)
IF(J.EQ.1)GO TO 10024
IF(N.NE.3)GO TO 177
IF(V(K+J+1).EQ.101.)J=J-1
177 N=V(K-2)
L=N/10000
M=N-L*10000
TYPE 10022,INST(L),M,J
10024 K=K+ABS(V(K-1))
10021 K=K+1
IF(K.LT.I)GO TO 10023
40021 IF(MZ.NE.-4)GO TO 1002
N=1
40022 K=N+1
IF(N.GT.I)CALL EXIT
X=V(N)
IF(X.EQ.-199.)GO TO 40024
IF(X.EQ.-99.)GO TO 40024
IF(X.GE.0)GO TO 40023
CC PRINT 4002,X
TYPE 4002,X
N=N+1
GO TO 40022
40024 J=N+1
GO TO 40025
C FOR 'SECTIONS'
40023 J=ABS(V(K))+K-1
CC40025 PRINT 4002,(V(K),K=N,J)
40025 TYPE 4002,(V(K),K=N,J)
N=J+1
GO TO 40022
10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
4002 FORMAT(10F12.3)
1002 IF(IDALL)GO TO 600
X=DUR(IDALL)
DO 2002 K=1,NINS
2002 IF(DUR(K))DUR(K)=X
C ***** SORTER *************************
C ******* OUTPUT LOOP FROM HERE ON ********
600 IL=0
C********** BELOW IS FOR 'SECTIONS'
KODE=0
NWX=NWX+1
MK=MK+1
Y=BNW(NW)
723 IL=IL+1
3723 Z=V(IL)
IF(Z.EQ.-19899.)GO TO 732
IF(Z.NE.-9900.-Y)GO TO 723
C********** BELOW IS FOR 'SECTIONS'
IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
2723 IL=IL+1
729 K=IL+2
MOT=V(IL+1)
RD=V(K)
IF(RD.EQ.-67.)GO TO 3726
RB=V(IL)
C************ DOWN TO 4150 IS FOR 'SECTIONS'
IF(RB.NE.-99.)GO TO 4150
KODE=IV(K-1)
2160 IF(KODE.EQ.0)GO TO 723
IF(MZ)WRITE(JOUT,9150),KODE
KL=Y/10000.
RB=Y+KL*10000.
DO 5150 KL=1,I
IF(V(KL).NE.-199.)GO TO 5150
IF(IV(KL+1).NE.KODE)GO TO 5150
IV(K-1)=0
C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
RD=V(KL+2)+9900.
DO 6150 L=KL+2,I
M=V(L)/(-9900.)
IF(M.NE.1)GO TO 6150
RA=RB+RD-V(L)-9900.
V(L)=-9900.-RA
C UPDATES BG TIMES INSIDE SECTION.
CALL BGSORT(RA)
C7150 IF(RA.EQ.BNW(KA))GO TO 6150
C UPDATES LIST OF CHANGE TIMES.
6150 IF(V(L).EQ.-299.)GO TO 160
5150 CONTINUE
160 IL=1
GO TO 3723
C*********** ABOVE IS FOR 'SECTION' REPEATS
4150 LK=RB/10000.+.2
IF(LK.GE.98)GO TO 7700
LP=RB-LK*10000
C LK=INST # LP=PARAM #
LN=IPT(LK,LP)
IPT(LK,LP)=IL+2
IF(RD.EQ.-66.)GO TO 726
IF(RD.EQ.-55.)GO TO 1726
IF(RD.EQ.-56.)GO TO 1726
IF(RD.EQ.-23)GO TO 6700
2727 ML=IPT(LK,LP)
IF(MOT.GT.0)GO TO 3727
C USE NEG WDCNT FOR 'ALL'
DO 4727 KL=LK+1,NINS
IF(NP(KL).GE.LP)GO TO 277
IF(LP.LT.31)NP(KL)=LP
277 IPT(KL,LP)=-(LK+(LP-1)*KZY)
NCNT(KL,LP)=10000
4727 IF(DUR(KL))DUR(KL)=1000.
C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
GO TO 727
C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
3727 IF(LN.LE.0)GO TO 727
IF(V(IL).NE.V(LN-1))GO TO 727
DO 1727 L=1,NINS
DO 1727 KL=1,NP(L)
IF(LN.NE.IPT(L,KL))GO TO 1727
NCNT(L,KL)=10000
C ******* JAN 29,70
IPT(L,KL)=ML
C RESETS POINTERS FOR DUPL AND REP INSTS.
C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
1727 CONTINUE
727 NCNT(LK,LP)=10000
C******** MAY 13,71 RHY REP. FEATURE OMITTED.
2150 IF(MOT)MOT=-MOT
IL=IL+MOT+1
3150 IF(V(IL))GO TO 3723
GO TO 729
726 RB=V(IL+3)
K=RB/10000.
L=RB-K*10000
IPT(LK,LP)=-(K+(L-1)*KZY)
GO TO 2727
3726 LK=V(IL)
M=V(K+1)
KL=NP(M)
DO 4726 L=1,KL
IPT(LK,L)=IPT(M,L)
IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
C****** JUN 29 71 (LK,L) WAS (L,K)....???????
4726 CONTINUE
IPT(LK,31)=IPT(M,31)
K=0
GO TO 2150
C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
6700 KL=IL+V(IL+1)+1.3
RC=V(K-2)
1770 IF(V(KL))GO TO 700
2700 KL=KL+V(KL+1)+1.3
GO TO 1770
700 KL=KL+1
IF(Z.NE.V(KL-1))GO TO 2700
IF(V(KL).NE.RC)GO TO 2700
KL=KL+3
KN=IL+3
LN=V(KN)+.3
DO 3700 L=1,LN,2
RA=V(L+KN)
KA=V(L+KN+1)+.3
RB=0
DO 4700 LP=1,KA
4700 RB=RB+V(KL+LP)
DO 5700 LP=1,KA
5700 V(KL+LP)=V(KL+LP)/RB*RA
V(KL+KA)=V(KL+KA)+.00030
3700 KL=KL+KA
GO TO 2150
C BELOW FOR 'TEMPO' SETUP
7700 T2=V(IL+4)
T1=V(IL+3)
TBG=Y
TDUR=V(IL+2)
CALL SQYY(AC,T1,T2,TDUR)
8700 IF(TDUR.EQ.0)TDUR=10000.
T5=1.
T6=TBG+TDUR
IT3=1.
IF(LK.EQ.98)IT3=IL+2
T4=1.
GO TO 2150
C*************** ANY WDCNTS DOWN FROM HERE. *********
C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
1726 IF(V(IL-1).GT.-19000.)GO TO 2727
RA=BT
K=IL-1
2726 V(K)=-9900.-RA
ISUB=-1
L=K+5
RB=V(L)+V(L-1)
V(L-1)=RA
K=K+V(K+2)+2
IF(V(K).GT.-19000.)GO TO 2727
IF(V(K+1).NE.V(IL))GO TO 2727
IF(V(K).NE.-9900.-RB)GO TO 2727
RA=RA+V(L)
CALL BGSORT(RA)
GO TO 2726
C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
732 DO 2606 K=NW,NWZ
2606 BNW(K)=BNW(K+1)
NWZ=NWZ-1
IF(NWZ.EQ.0)GO TO 2111
IF(NWZZ.EQ.1)GO TO 5111
NWZZ=1
IF(NWZ.EQ.1)GO TO 1111
DO 3111 K=1,NWZ
IF(BNW(K).LT.1000.)GO TO 3111
X=BNW(NWZZ)
BNW(NWZZ)=BNW(K)
BNW(K)=X
NWZZ=NWZZ+1
3111 CONTINUE
5111 IF(NWZZ.EQ.NWZ)GO TO 1111
L=NWZZ+1
X=BNW(NWZZ)
DO 4111 K=L,NWZ
IF(BNW(K).GT.X)GO TO 4111
RA=BNW(K)
BNW(K)=X
X=RA
4111 CONTINUE
BNW(NWZZ)=X
GO TO 1111
111 FORMAT(1XA5,'.SCR',12X,'EDIT FILE NAME=',A5,8X,
1'STORAGE=',I4,'/',I4,/' TEMPO FACTOR=',F6.2/)
1023 FORMAT(/' < ',A5,'.SCR -- RANDOM NUMBER=',I6/1XA5)
C********** BELOW IS FOR 'SECTIONS'
9150 FORMAT(/3X'******* SECTION ',A1)
2111 NWZ=-1
C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
1111 IF(MZ.EQ.0)GO TO 1601
IF(NWX.NE.1)GO TO 1486
WRITE(JOUT,111)ISLAC,IFLNM,I,LIMIT,TF
C*********** JUNE 1,71
C********** BELOW IS FOR 'SECTIONS'
1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
K=NWX-1
C*********** JUNE 1,71
IF(NWX.LE.1)GO TO 377
IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y
377 IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
C*********** JUNE 1,71 X 3 K'S
DO 602 K=1,NINS
48 LK=INST(K)
C*********** JUNE 1,71
IF(NCNT(K,31).EQ.10000)GO TO 477
IF(NWX.GT.1)GO TO 602
477 NCNT(K,31)=1
IJ=IPT(K,31)
X=0
IF(IJ.NE.0)X=V(IJ+2)
WRITE(JOUT,5396),LK,X
X=DUR(K)
IF(X.GT.10000.)GO TO 83
WRITE(JOUT,8396),X
GO TO 602
5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
7396 FORMAT('+',F5.0,' NOTES')
8396 FORMAT('+',F6.2,'"')
83 X=X-10000.
WRITE(JOUT,7396),X
602 CONTINUE
715 IF(IT3.NE.1.)GO TO 1602
RA=T1*TP
RB=T2*TP
WRITE(JOUT,6154),RA,RB,TDUR
IT3=0
1602 IF(NWX.EQ.1)GO TO 315
IF(IT(J).EQ.-3)GO TO 1108
IT(J)=IT(J)/10
GO TO 1108
C*********** JUNE 1,71
6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
902 FORMAT(1XA5/)
3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
C*********** JUNE 1,71
CC1715 FORMAT(' RCDFLG',A5)
C RCD IS SET IN DATA (←-1;)
315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
IF(OP1.NE.0)WRITE(JOUT,4154),OP1
1601 IF(NWX.GT.1) GO TO 1108
IF(TF.GT.10.)TF=TF/60.
TF=100./TF
CROFF 100 HERE FOR NEW DAC!?#@&βX 1/76 TF=1000./TF
DO 6015 K=1,30
6015 COPY(K)=-9900.
C INITS PARAM REPRESSION FEATURE.
CC IF(MZ)WRITE(JOUT,1715)RCD
CC IF(MX)WRITE(1,1715)RCD
C 7/75 NOW WRITES 'RCDFLG=-1;' BEFORE! ANY INSERTS AND 'PLAY'.
IF(KB.EQ.0)GO TO 9926
ML=NINS+1
NL=NINS+KB
DO 9826 K=ML,NL
BW=OTH(K-NINS,1)
IF(BW.NE.-99)GO TO 9826
K=K-NINS
GO TO 5741
C 'INSERT -99;' COMES BEFORE 'PLAY;'
9726 BW=19999.
K=K+NINS
9826 BG(K)=BW
C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
9926 DO 5015 K=1,NINS
IQ(K)=BG(K)*10000.
BG(K)=0
INP(K)=0
P1(K)=0
IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
5015 CNT(K)=0
IF(MZ)WRITE(JOUT,1023),ISLAC,IXIN,PLAY
IF(MX)WRITE(1,1023)ISLAC,IXIN,PLAY
BW=0
GO TO 500
752 FORMAT(1X15A5)
1108 M=0
JC=0
IF(NWZ)GO TO 1740
C NWZZ IS SET AT 3111 IN SORTR.
DO 740 K=1,NWZZ
X=BNW(K)
IF(X-.0001.GT.BT)GO TO 2740
IF(X.LE.BW)GO TO 2740
IF(BW)GO TO 2740
IT(J)=IT(J)*10
NW=K
GO TO 600
2740 IF(X.LT.1000.)GO TO 740
IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
X=BT+PR
NW=K
BX=CNT(J)+1.
IT(J)=-3
GO TO 600
740 CONTINUE
IT(J)=0
1740 IF(J.LE.NINS)GO TO 31
7021 K=J-NINS
IF(JC.GT.0)K=JC
5740 IF(PP1.LT.OP1)GO TO 1752
5741 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
DO 17521 L=3,30
17521 COPY(L)=-9900.
C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
1752 BG(K+NINS)=19999.
OTH(K,1)=19999.
IF(BW.EQ.-99)GO TO 9726
IF(JC.GT.0)GO TO 21
31 KL=1
IF(KB.EQ.0)GO TO 2031
DO 1031 L=1,KB
K=L
X=OTH(K,1)-1000000.
M=X/100000.
IF(M.NE.J)GO TO 1031
IF(IQ(J).NE.0)GO TO 1031
C M=INST
IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
1031 CONTINUE
IF(J.GT.NINS)GO TO 500
2031 CNT(J)=CNT(J)+1
ICT=CNT(J)
C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
NPA=NP(J)
PP1=P1(J)
IF(BT.GE.DUR(J))GO TO 5174
IF(IQ(J).EQ.0)GO TO 200
P2=-IQ(J)/10000.
IQ(J)=0
CNT(J)=-1
ICT=-1
CC MK=-1
C PRINTS REST AND CNT=-1 WHEN 1ST BG TIME IS >0
GO TO 4203
C MK IS FLAG FOR RESTS
200 MK=0
IF(BT.NE.0)GO TO 577
IF(J.EQ.1)GO TO 203
577 IF(IPT(J,1).EQ.0)GO TO 203
KN=IPT(J,1)-1
IF(KN.GT.0)GO TO 12033
12032 KN=JPT(-KN)
IF(KN)GO TO 12032
KN=KN-1
C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
12033 IJ=V(KN)
IF(ABS(V(KN)).EQ.4.)GO TO 1203
C 'IABS' IS FOR -4 USED WITH 'ALL'
Z=(BT+9900.+V(KN-2))/V(KN+2)
C******* FEB 19,71
IF(Z.GT.1.)Z=1.
Y=V(KN+3)
X=(V(KN+4)-Y)*Z+Y
C******* FEB 19,71
GO TO 204
1203 X=V(KN+3)
204 Y=RAND(0.0,1.0)
IF(Y-X)MK=-1
203 DF=1.
C DF=DUTY FACTOR
DO 2155 L=2,NPA
ISUB=0
C WHY DOES ISUB APPEAR AT 14700/5?
IDF=0
C IDF IS DUTY FACTOR FLAG
IJ=IPT(J,L)
12031 IF(IJ)IJ=JPT(-IJ)
IF(IJ)GO TO 12031
C FOLLOWS UP ON POINTERS TO POINTERS!
PM=1.
IF(IJ.GT.1)GO TO 2157
P(L)=0
GO TO 21551
C 7/73
2157 LN=IJ+2
NM=ABS(V(IJ-1))+LN-4
NL=V(IJ)
IF(NL.GT.-100)GO TO 272
IF(NL.GT.-200)GO TO 372
ISUB=-1
NL=NL+200
C FOR SUBROUTINE FLAG
372 IF(NL.GT.-100)GO TO 272
IDF=-1
NL=NL+100
C DEC.6,72 FINDS DUTY FACTOR PARAM
272 VIJ2=V(IJ+1)
KN=NL/(-11)
IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65,67,68),KN
1100 IF(VIJ2.EQ.1.)GO TO 1200
ML=3
1900 KA=1
VX1=0
DO 1156 K=LN,NM,ML
VX(KA+1)=V(K)+VX(KA)
1156 KA=KA+1
X=RAND(0.0,1.)
DO 1157 K=2,11
IF(X.GT.VX(K))GO TO 1157
KL=K-1
IF(KN.EQ.7)GO TO 6157
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
1462 RA=V(LN)
IF(RA.EQ.10000.)GO TO 5174
C FOR "FINE" IN RLIST
RB=V(LN+1)
PAR=RAND(RA,RB)
1300 IF(NL.NE.-1)PM=2.
C IF 2 THEN PRINTS A5
GO TO 1155
1200 PAR=V(IJ+2)
GO TO 1300
C NEXT IS FOR SUBROUTINE AND QUAD CALLS
61 IF(NL.LT.-12)GO TO 6100
601 IF(ISUB.EQ.-2)GO TO 2601
X=P2
C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
CALL SUBR
CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
IF(L.EQ.2)GO TO 4203
IF(X.EQ.P2)GO TO 21552
PP2=P2
PR=P2
GO TO 21552
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C BE SET TO 'REAL TIME'.)
2601 CALL NMCHG
GO TO 21552
6100 IF(NL.EQ.-19)GO TO 6101
C NEXT IS FOR QUAD ROUTINES
CALL QUAD(NL)
GO TO 21552
6101 COFF1(J)=V(LN)
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
COFF2(J)=V(LN+1)
GO TO 2155
C FOLLOWING IS FOR STRINGS OF VALUES.
62 KL=NCNT(J,L)+1
IF(KL.GT.VIJ2)KL=1
IF(NL.EQ.-46)GO TO 677
IF(NL.NE.-36)GO TO 162
C THIS PART FOR STRINGS OF RAND SELECTION
677 LN=KL+IJ+1
KL=KL+1
IF(KL.GT.VIJ2)KL=1
NL=NL+45
C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
162 NCNT(J,L)=KL
IF(NL.GT.-22)GO TO 1462
C JUMP RAND SELECTION
PAR=V(IJ+KL+1)
C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
C************************
IF(KN.NE.3)GO TO 1155
C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
IF(PAR.EQ.10000.)GO TO 5174
PM=2.
IF(PAR.GT.100.)GO TO 777
IF(PAR.GE.1.)GO TO 877
777 PM=3.
877 IF(PAR.EQ.85.)MK=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=ABS(V(IJ-1))
IF(NL.EQ.-56)GO TO 977
IF(NL.NE.-58)GO TO 771
977 PM=2.
771 Z=(BT-W)/VIJ2
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=V(LN)
W=V(IJ+3)
IF(X.EQ.7.)W=V(IJ+4)
IF(NL.LT.-58)GO TO 16002
PAR=(W-Y)*Z+Y
IF(X.EQ.7.)GO TO 1600
GO TO 1155
C************** JUNE 1,71
C FOR "MOVX"
C******** FEB/73
C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
16002 PAR=RMOVX(W,Y,Z)
C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
C THIS NEEDS WORK!
IF(X.NE.7.)GO TO 1155
W=V(IJ+5)
Y=V(IJ+3)
X=RMOVX(W,Y,Z)
GO TO 16003
C NEXT IS FOR MOVING RAND RANGES.
C1600 PAR=(V(IJ+4)-Y)*Z+Y
1600 W=V(IJ+3)
C*********** BACK TO 65 IS NEW. FEB. 15,71
X=(V(IJ+5)-W)*Z+W
C************ JUNE 1,71
16003 PAR=RAND(PAR,X)
GO TO 1155
67 LN=IJ+3
NM=LN+VIJ2-1
ML=1
GO TO 1900
4155 K=(PAR-9999.0)*100.+.1
P(L)=P(K)
IF(L.NE.2)GO TO 772
IF(K.EQ.2)P2=PX2
C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
772 PM=PL(K)
GO TO 21551
C 9999.nn REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
6157 LN=V(LN-1)
DO 1068 K=1,KL
1068 IF(K.LT.KL)LN=LN+V(LN)+1
2068 PM=LN+1
PAR=LN+V(LN)
GO TO 5155
68 KL=NCNT(J,L)
IF(KL.EQ.0)GO TO 774
IF(KL.NE.10000)GO TO 773
774 KL=VIJ2
773 PM=KL+1
PAR=PM+V(KL)-1
KL=PAR+1
IF(V(KL).EQ.10000.)DUR(J)=BT
C 'END' OR 'FINE' IN 'LIT' LIST.
IF(V(KL).EQ.999.)KL=IJ+2
NCNT(J,L)=KL
IF(NL.EQ.-89)ISUB=-2
C -89= 'NAME' FEATURE. CHANGES INST. NAME EACH NOTE, ACCORDING TO LIST.
GO TO 5155
C ******* JAN 20 *************
1155 IF(PAR.EQ.10000.)GO TO 5174
C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
IF(PAR.LE.9999.)GO TO 5155
IF(PAR.GE.9999.4)GO TO 5155
IF(PM.EQ.1.)GO TO 4155
C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
5155 P(L)=PAR
21551 PL(L)=PM
IF(ISUB)GO TO 601
IF(L.EQ.2)GO TO 4203
21552 IF(IDF.GE.0)GO TO 2155
DF=PAR
C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
IDF=0
2155 CONTINUE
9203 IF(KB.EQ.0)GO TO 1170
NL=KB
DO 2203 K=1,KB
X=OTH(NL,1)
IF(X.LT.100000.)GO TO 2203
L=X/100000.
Y=(X-L*100000.)/100.
IX=Y
JC=NL
IF(J.NE.L)GO TO 2203
IF(IX.EQ.ICT)GO TO 5203
2203 NL=NL-1
GO TO 1170
4203 X=COFF1(J)
IF(X.LE.BT)GO TO 6102
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
CC IF(P2.NE.PX2)GO TO 2155
C JUMP IF 'TEMPO' CHANGE
IF(BT+P2.GT.X-COFF2(J))P2=X-BT
6102 PR=P2
PX2=P2
C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
IF(T5.EQ.0)GO TO 7203
IF(IT3.LE.1)GO TO 6203
IF(BT.LT.TBG+TDUR)GO TO 6203
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
CALL SQYY(AC,T1,T2,TDUR)
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
C75 RD=1
KA=1
C75 RB=0
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
CALL ACCEL
8203 P2=RA*RD
7203 P2=P2*T4
X=ABS(P2*TF)
C P2 IS KEPT WITHOUT TF*
K=X+.5
Y=ROFF(J)
Y=Y+K-X
IF(ABS(Y).LT.1.)GO TO 7155
CCC IF(X)K=X-.5
CCC72031 ROFF(J)=ROFF(J)+K-X
CCC IF(ABS(ROFF(J)).LT.1.)GO TO 7155
CCC Y=1.
CCC IF(ROFF(J))Y=-Y
CCC K=K-Y
CCC ROFF(J)=ROFF(J)-Y
X=1
IF(Y)X=-X
K=K-X
Y=Y-X
C ROUND-OFF GAP WILL NOT EXCEED .001****.01 WITH NEW DAC!X?#@
C*********** FEB 17,71
7155 IF(P2)K=-K
PP2=K/100.
CCC7155 PP2=K/100.
ROFF(J)=Y
CROFF7155 PP2=K/1000.
C AVOIDS ROUND-OFF PROBLEMS **** TO 1/100 (1/76)
C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
IF(IPT(J,31).EQ.0)GO TO 6155
IF(ICT)GO TO 1170
X=V(IPT(J,31)+2)/2.
IF(PP2.GE.0)GO TO 615
MK=-1
PP2=-PP2
615 Y=RAND(-X,X)
IF(Y.GE.PP2)Y=PP2/2.
PP2=PP2-RDEV(J)+Y
RDEV(J)=Y
C TOTAL RAND DEV. WON'T EXCEED P31
C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
K=PP2*100.+.5
CROFF K=PP2*1000.+.5
C****** CHECK THIS OUT 1/10/72 :::::::
61551 PP2=K/100.
C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
6155 IF(ICT)GO TO 9203
GO TO 2155
5203 JD=Y*100-IX*100+.5
IF(JD.GT.0)GO TO 3203
M=0
P1(J)=PP1+PP2
GO TO 7021
3203 P(JD)=OTH(JC,2)
X=OTH(JC,3)
IF(X.NE.1.)X=3.
C 'EDITS' PRINT,NUM. OR 5 CHARS.
PL(JD)=X
C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
IF(JD.EQ.2)PP2=P2
C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
1170 IF(MK)GO TO 2022
IF(PP2)GO TO 2022
ZPAR=PP1
P1(J)=PP1+PP2
C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
LK=INST(J)
2021 IF(PP1.LT.OP1)GO TO 2612
IF(INVIS(J).LT.0)GO TO 2170
C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
IF(INONLY.GT.0)GO TO 1204
C*********** MAY 16,71 ↑↑↑
6021 IF(P(NPA).NE.COPY(NPA))GO TO 5021
IF(PL(NPA).GT.1)GO TO 5021
C******* MAY 25,71
C 'LIT' DATA WILL ALWAYS PRINT.
NPA=NPA-1
IF(NPA.GT.2)GO TO 6021
5021 DO 1304 K=3,NPA
1304 COPY(K)=P(K)
1204 IF(PL4.NE.1.)GO TO 2170
P4=P4*AMPFAC
L=0
INP(J)=P4
DO 1021 K=1,NINS
1021 IF(P1(K).GT.PP1)L=L+INP(K)
IF(L-IAMP-1)GO TO 2170
IAMP=L
AMPTIM=PP1
2170 IF(MX.EQ.3)GO TO 2612
C ********* MAY 17,71
PP1=PP1-OP1
C PUTS SPACES BETWEEN NOTES .GT. .05( APART
IF(MZ.NE.-1)GO TO 5170
IF(A.GE.PP1)GO TO 5170
IF(INONLY)WRITE(JOUT,902)
A=PP1+.05
5170 ML=10
IF(NPA.LT.10)ML=NPA
MLX=3
NL=2
IEND=0
K=INVIS(J)
IF(K.EQ.0)GO TO 3170
IF(K.EQ.-1)GO TO 9170
IEND=-1
C THIS DELETES END PRINTOUT ( ;PRINT P1 ETC.)
GO TO 3170
C -1=INVIS FRONT, -2=INVIS END
9170 LK=0
C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
C NEXT CREATES FORMAT DATA IN IFM ARRAY.
31701 KL=3
GO TO 4170
3170 IF(J.EQ.INONLY)GO TO 775
IF(.NOT.INONLY)GO TO 2612
775 VX(1)=PP1
IF(DF.GT.0)GO TO 6170
VX2=PP2+DF
IF(VX2.LE.0)VX2=PP2/2
C NO NEG. TIME VALUES ALLOWED.
C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
GO TO 7170
6170 IF(DF.LT.100)GO TO 8170
C DF+100=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
C DF+1000=FIXED TIME OF OVERLAP 3/77 (CHNG THIS TO 300 SOMEDAY!)
IF(DF.GT.1000)GO TO 8171
VX2=DF-100.
IF(VX2.GT.PP2)VX2=PP2
C DF+200= FIXED DURATION WITHOUT REGARD TO OVERLAPS
IF(DF.GT.200)VX2=DF-200.
GO TO 7170
C*** NEXT FOR DF>1000 ****!!!! SWITCH THIS FEATURE WITH ORD. DF SOMEDAY!!!!
8171 VX2=PP2+DF-1000.
GO TO 7170
8170 VX2=PP2*DF
7170 IFM3='F9.2,'
IFM4=IFM3
KL=5
IF(NPA.LT.3)GO TO 2121
4170 NL=2
DO 1121 K=MLX,ML
X=P(K)
L=PL(K)
IF(L-2)321,521,621
C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
321 IF(X.GE.0)GO TO 4211
IFM(KL)=IFCOM
NL=NL+1
KL=KL+1
4211 IFM(KL)='F7.2,'
IF(P(K).GT.999.99)IFM(KL)='F9.1,'
C CREATES 'F9.1' FOR BIGGER NUMS. (NO NEGS <-999.99)
421 VX(KL-NL)=X
GO TO 1121
521 IFM(KL)=IFM2
C CREATES '1XA5'
LN=X
VX(KL-NL)=SCAL(LN)
GO TO 42
621 IF(L.GT.3)GO TO 721
VX(KL-NL)=X
C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
42 IFM(KL)=IFM2
GO TO 1121
721 LN=X
IFM(KL)=I1X
NL=NL+1
DO 821 M=1,LN-L+1
KL=KL+1
IOUT(KL-NL)=IV(L-1+M)
821 IFM(KL)=IA1
1121 KL=KL+1
C NO MORE THAN 80 ITEMS IN FORMAT.
2121 IF(KL.LE.80)GO TO 21211
21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
TYPE 21212
21211 DO 921 M=KL+1,80
921 IFM(M)=IBLA
IFM(KL)=')'
L=KL-NL-1
IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
IF(.NOT.MZ)GO TO 30210
IF(ML.GE.NPA)IFM(KL)='$)'
WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
30210 IF(ML.GE.NPA)GO TO 3021
MLX=ML+1
ML=ML+10
IF(ML.GT.NPA)ML=NPA
LK=IBLA
GO TO 31701
3021 IF(IEND)GO TO 30211
C IEND=-1 FOR INVIS. ENDING. (ALLOWS EXTENTION OF P LIST.)
IF(MX)WRITE(1,3616)INST(J),ICT
30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
2612 PP1=ZPAR
GO TO 21
8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
3616 FORMAT(';PRINT P1;< ',A5,I4)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
INP(J)=0
P1(J)=PP1+PP2
C STORES NEXT P1 TIME FOR THIS INST.
IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
X=PP1-OP1
IF(A.GE.X)GO TO 121
WRITE(JOUT,902)
A=X+.05
C NEXT PRINTS A REST INDICATION
121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
1 J,INST(J),ICT,BT
21 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSERTS CANT FOLLOW LAST REGULAR NOTE.
C (ADD REST IF INSERT AT END IS NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
NL=NINS+KB
DO 22 K=2,NL
22 IF(BG(J).GT.BG(K))J=K
IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
J=1
DO 5022 K=2,NINS
X=P1(J)
Y=P1(K)+.0001
C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
IF(BG(J).EQ.19999.)X=19999.
IF(BG(K).EQ.19999.)Y=19999.
5022 IF(X.GT.Y)J=K
C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
3022 BT=BG(J)
IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
IF(CNT(J).GT.0)GO TO 1022
IF(CNT(J).EQ.0)P1(J)=0
IF(CNT(J).EQ.-1)CNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
T4=T2
T5=0
T6=10000.
GO TO 1108
1175 FORMAT('+',A5,'=',F7.3,2X,$)
1109 FORMAT(' FINISH; < ',A5,'.SCR')
1110 FORMAT(' <',A5,2F8.2,2X,'******* REST <'I2,1XA5,I4,F12.3)
1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I6,', AT TIME'
1,F8.3)
175 IF(MZ)WRITE(JOUT,1109),ISLAC
IF(MX.GE.0)GO TO 4175
WRITE(1,1109),ISLAC
END FILE 1
TYPE 60003
60003 FORMAT(' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
603 FORMAT(' TOTAL DURS: ',$)
CC FOR COLGATE ONLY***4175 CALL ENDSUB
C CLEARS CNTL O --- IF YOU HAVE HIT IT.
4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
WRITE(JOUT,603)
5175 DO 2175 K=1,NINS
X=P1(K)-OP1
IF(MZ)GO TO 6175
TYPE 1175,INST(K),X
GO TO 2175
6175 WRITE(JOUT,1175),INST(K),X
2175 CONTINUE
IF(JOUT.NE.22)GO TO 3175
END FILE 22
TYPE 7175
7175 FORMAT(' GOING TO LPT')
CALL PRINT
REWIND 22
K='FOR22'
CALL OFILE(22,K)
END FILE 22
3175 TYPE 1023,ISLAC,IXIN
CALL EXIT
END
C ***** SCANNER *************************
C* SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN,ACCEL,POINTR 7/74
SUBROUTINE SCANR
DIMENSION IP(30)
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1/E/IQ(27),ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
EQUIVALENCE(IF,ISCA(6)),(ISS,ISCA(9)),(IE,ISCA(5)),(IDOT,IDAT(11))
1 ,(IEN,ISCA(4)),(IP,PL)
C 2/74 IP IS NOW EQUIV TO PL! USED TO BE IP WITH P.(HURT 'TAP' ROUTINE.)
C WILL THIS DO ANYTHING TO MUSIC5 VERSION??
NNUM=-1
ISKP=0
JJ=0
XMINUS=1.
999 IDECI=-1
M=0
2799 N=INP(ML)
IF(N.NE.IQT)GO TO 899
JA=-1
ML=ML+1
ISUB=8
JJ=JJ+1
VX(JJ)=ML
C POINTS TO FIRST LIT. CHAR.
DO 1177 K=ML,144
IF(INP(K).NE.IQT)GO TO 1177
ML=K+1
2177 N=INP(ML)
GO TO 899
1177 CONTINUE
C SKIPS 'LIT' ITEMS IN RAN. SELECTION
899 ML=ML+1
IF(N.EQ.ISEMI)GO TO 751
IF(N.NE.IBLA)GO TO 510
4702 IF(ISKP)202,2799,2799
510 IF(JA)GO TO 70
C********** MAY 22,71
DO 77 K=1,12
IF(N.NE.ISCA(K))GO TO 77
IF(K.EQ.2)GO TO 1511
IF(K.NE.4)GO TO 511
1511 NSWCH=K-4
GO TO 2177
C TO SWITCH ALWAYS USE OCT.# /PBF4/ /OE5/ P=PROXIMITY, O=ORDINARY
C ************ MAY 22,71
511 NNUM=K
JJ=JJ+1
NFLG=-1
N=INP(ML)
IF(N.NE.IF)GO TO 410
NNUM=NNUM-1
GO TO 610
410 IF(N.NE.ISS)GO TO 3410
NNUM=NNUM+1
610 ML=ML+1
N=INP(ML)
3410 IF(N.EQ.IEN)GO TO 3411
IF(N.NE.'I')GO TO 371
C 'END' OR 'FINE' WILL END INST.
C******** MAY 20,71
3411 VX(JJ)=10000.
IF(DUR(LK))DUR(LK)=1000.
IAMP=-1
RETURN
371 IF(N.EQ.ISEMI)GO TO 5410
IF(N.EQ.IBLA)GO TO 5410
DO 177 KN=2,9
IF(N.NE.IDAT(KN))GO TO 177
IF(KN.EQ.9)CALL ERR(4)
C FOUND OCTAVE NUM.8 -- TOO HIGH!
JSCA=KN-2
ML=ML+1
GO TO 2410
177 CONTINUE
GO TO 6410
5410 KN=-1
6410 IF(NSWCH.EQ.0)GO TO 2410
IF(KN)GO TO 7410
CC IF(N.EQ.'+')NOLD=NOLD+6
CC IF(N.EQ.'-')NOLD=NOLD-6
C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
7410 IF(NOLD-NNUM.LE.5)GO TO 7411
IF(JSCA.LT.7)JSCA=JSCA+1
7411 IF(NOLD-NNUM.GE.-5)GO TO 2410
IF(JSCA.GT.0)JSCA=JSCA-1
C WILL JUMP TO NEAREST NOTE *********** MAY 22,71
2410 VX(JJ)=JSCA*12+NNUM
NOLD=NNUM
C ********** MAY 22,71
4410 NNUM=-2
IF(INP(ML).EQ.ISEMI)RETURN
C ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
IF(N.EQ.IXX)GO TO 210
IF(N.EQ.'*')GO TO 210
GO TO 310
C *********MAY 22,71
77 CONTINUE
70 IF(N.NE.'-')GO TO 71
XMINUS=-1.
GO TO 2799
210 JJ=JJ+1
IF(JJ.EQ.1)GO TO 3310
C****** MAY 19,71
XMINUS=1.
VX(JJ)=0
C 'X N1,N2' MAY REPLACE 'REP N1,N2'. N2=0 BECOMES N2=2
GO TO 310
71 IF(N.EQ.IXX)GO TO 210
IF(N.EQ.'*')GO TO 210
IF(N.EQ.'R')GO TO 73
1410 DO 78 K=1,11
IF(N.NE.IDAT(K))GO TO 78
ISKP=-1
IF(N.NE.IDOT)GO TO 79
IDECI=M
GO TO 75
79 M=M+1
IP(M)=K-1
GO TO 75
78 CONTINUE
IF(N.NE.IE)GO TO 8811
IF(INP(ML).NE.IEN)GO TO 781
GO TO 7811
8811 IF(N.NE.IF)GO TO 781
IF(INP(ML).NE.'I')GO TO 781
C 'EN(D)' OR 'FI(NE)' WILL END INST.
7811 JJ=1
GO TO 3411
781 IF(N.EQ.'/')N=ISEMI
C FOR MOTIVIC TRANFORMATIONS
75 KN=INP(ML)
IF(KN.NE.IXX)GO TO 175
IF(INP(ML+1).NE.'(')GO TO 202
C "X(" STARTS A 'MOTIF' BUT "X (" WON'T WORK!!!!
175 IF(KN.EQ.'*')GO TO 202
C FOR 2X3, 2*3, ETC. CHECK THIS OUT. 6/74
CC75 IF(INP(ML).NE.IXX)GO TO 752
CC ML=ML-1
CC GO TO 202
C FOR 'X' AND '*' WITHOUT SPACES.
IF(N.EQ.ISEMI)GO TO 751
IF(KN.NE.1)GO TO 2799
C WHEN IS INP(ML) (I.E. KN) SET TO 1?????
751 IF(ISKP.EQ.0)RETURN
202 IF(IDECI.NE.-1)GO TO 302
IDECI=0
GO TO 402
302 IDECI=M-IDECI
402 KN=0
IEXP=M-1
IF(M.LT.1)M=1
DO 171 K=1,M
KV=10**IEXP
IF(IEXP.EQ.0)KV=1
KN=KN+IP(K)*KV
171 IEXP=IEXP-1
A=10**IDECI
IF(IDECI.EQ.0)A=1.
JJ=JJ+1
VX(JJ)=KN/A*XMINUS
IF(ISUB.EQ.1)RETURN
IF(CODE.NE.-22.)XMINUS=1.
C ONLY ONE - NEEDED FOR RHY.COMPOSITE
1310 IF(INP(ML).NE.1)GO TO 310
VX(JJ+1)=VX(JJ)*2.
JJ=JJ+1
ML=ML+1
GO TO 1310
206 ML=ML+2
3310 VX(1)=-99.
C******** MAY 19,71
310 ISKP=0
IF(N.NE.ISEMI)GO TO 999
RETURN
73 JJ=JJ+1
IF(INP(ML).EQ.IE)GO TO 206
C NEXT IS FOR A REST ('R')
VX(JJ)=85.
C 7/75 GO TO 4410
731 N=INP(ML)
IF(N.EQ.'/')RETURN
IF(N.EQ.ISEMI)RETURN
IF(N.NE.IBLA)GO TO 899
ML=ML+1
GO TO 731
END
SUBROUTINE BGSORT(BW)
C THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
C ALLOWS 100 BG TIMES.
COMMON /Q/ BNW(100),NWZ
DO 5308 K=1,NWZ
X=BNW(K)-.0001
Y=X+.0002
C ROUND-OFF NONSENSE
IF(BW.LE.X)GO TO 5308
IF(BW.LT.Y)RETURN
5308 CONTINUE
NWZ=NWZ+1
BNW(NWZ)=BW
RETURN
END
SUBROUTINE FMT(JFM,INP,MLX)
DIMENSION JFM(3),INP(1)
DO 1 MLX=2,72
J=INP(MLX)
IF(J.EQ.' ')GO TO 2
IF(J.EQ.',')GO TO 2
IF(J.EQ.';')GO TO 2
1 IF(J.EQ.':')GO TO 3
C SPACE=COMMA=SPACE, ALSO STOPS ON ";"
3 CALL ERR(1)
C ERROR IF COLON IS FOUND OR THERE IS NO END MARK
2 MLX=MLX+1
IF(MLX.GT.7)MLX=7
JFM(2)='0'+(MLX-2)*536870912
C FINDS NUMBER FOR 'A' FORMAT
END
SUBROUTINE RANR(VX,K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
DIMENSION VX(1)
X=VX(K)
Y=VX(K+1)
IF(X.GT.Y)VX(K)=X+.999
IF(Y.GE.X)VX(K+1)=Y+.999
RETURN
END
SUBROUTINE SQYY(YY,X,Y,Z)
YY=2.*Z/(X+Y)
IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
RETURN
END
SUBROUTINE COLTTY(JNP,JT)
COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED /FRMT/J(2)
DIMENSION JNP(1)
DATA J(2)/'72A1)'/
DO 1 K=72,1,-1
1 IF(JNP(K).NE.' ')GO TO 2
K=1
2 IF(JT.EQ.21)GO TO 3
J(1)=' (1X'
IF(LN.EQ.0)GO TO 5
J(1)='(I6,X'
WRITE(JT,J)LN,(JNP(L),L=1,K)
RETURN
3 J(1)=' ('
5 WRITE(JT,J)(JNP(L),L=1,K)
END
FUNCTION READER(JNP)
DIMENSION JNP(72)
COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED
1 /FRMT/J(2)
DATA TPALN/20H(' TYPE A LINE'/) /
J(1)=' ('
READER=0
IF(ITYP)GO TO 1
6 TYPE TPALN
ACCEPT J,JNP
IF(JED)CALL COLTTY(JNP,21)
IF(JNP(1).EQ.' ')GO TO 6
RETURN
1 IF(LN.NE.0)GO TO 5
READ(1,J,END=3)JNP
GO TO 7
5 J(1)=' (I,'
READ(1,J,END=3)LN,JNP
7 IF(SOS)CALL COLTTY(JNP,JOUT)
RETURN
3 READER=-1
END
SUBROUTINE QUAD
C DUMMY -- FOR NOW. 7/74
END
FUNCTION RMOVX(W,Y,Z)
IF(W.EQ.0)W=.01
IF(Y.EQ.0)Y=.01
RMOVX=Y*((W/Y)**Z)
END
SUBROUTINE CLEAN(INP,LEND)
DIMENSION INP(1)
C CLEAR THE END OF ARRAY
M=72
LEND=-1
K=0
1 K=K+1
NN=INP(K)
IF(NN.EQ.';')GO TO 2
IF(NN.EQ.'/')GO TO 2
IF(NN.EQ.'<')GO TO 3
C USE < FOR COMMENT-- AS IN MUS10
IF(NN.EQ.',')INP(K)=' '
C CHANGE ALL COMMAS TO BLANKS
IF(NN.EQ.':')CALL ERR(1)
IF(NN.NE.'"')GO TO 4
7 K=K+1
IF(INP(K).EQ.'"')GO TO 4
IF(K.LT.M)GO TO 7
CALL ERR(5)
2 LEND=K
4 IF(K.LT.M)GO TO 1
3 IF(LEND.GT.0)RETURN
IF(M.EQ.144)CALL ERR(2)
CALL READER(INP(73))
C GO READ ANOTHER LINE.
M=144
K=72
GO TO 1
END
SUBROUTINE ERR(K)
GO TO(1,2,3,4,5)K
TYPE 199,K
199 FORMAT(' ERROR!! LAST LINE READ =',I6)
CALL EXIT
1 TYPE 11
CALL EXIT
11 FORMAT(' ILLEGAL COLON')
2 TYPE 12
CALL EXIT
12 FORMAT(' NO END MARK')
3 TYPE 13
CALL EXIT
13 FORMAT(' MORE THAN 2 PARENS OPEN')
4 TYPE 14
CALL EXIT
14 FORMAT(' SOME NUMBER TOO BIG')
5 TYPE 15
CALL EXIT
15 FORMAT(' OPEN QUOTES')
END
SUBROUTINE ACCEL
COMMON/VV/LIMIT,V(1)/A/ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
1 ,P1(27),JFM(4),COPY(30),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,NONO,RD,IA
C /C/=26
IF(T5.EQ.1)GO TO 4020
XA=RA
7020 RA=V(IA+K)
IF(RA.EQ.10000.)RETURN
4020 RD=1
IF(RA.LT.0)RD=-1.
RA=RA*RD
IF(KA.EQ.0)RA=RA-RC
W=RA
RB=W
IF(W.LE.Z-.0001)GO TO 2020
C .0001 FOR ROUND-OFF ERRORS!!!!!!!
IF(Z.NE.0)GO TO 3020
RA=RA/Y
RB=-1.
RC=0
GO TO 8020
3020 W=Z
RC=W+RC
GO TO 24
2020 RC=0
24 IF(X.NE.Y)GO TO 424
RA=W/X
GO TO 8020
C DUR OF TMP + BG TIME OF TMP - NOTE VALUE -
C BG TIME OF NOTE. CHN=TBG.
424 RAX=XT(J)
RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
XT(J)=RAX+YY*RA
8020 IF(KA.EQ.0)RA=RA+XA
KA=1
IF(RC.NE.0)GO TO 1011
IF(T5.EQ.1)RETURN
C T5=1 IN 'RUNIT'
V(IA+K)=RA*RD
IF(K.EQ.IZ)RETURN
C*********** JUNE 1,71
1011 IF(T5.EQ.1)GO TO 2011
K=K+1
IF(ZZ.NE.0)Z=Z-W
IF(Z.GT.0)GO TO 7020
IF(RB.EQ.-1.)GO TO 7020
IC=IC+1
IF(RB.EQ.W)RETURN
KA=0
K=K-1
RETURN
2011 XA=RA
IF(K.GT.1)GO TO 9020
K=I-6
ZPAR=-9900.-CHN-ZZ
DO 3011 KL=8,I
IF(V(K).NE.ZPAR)GO TO 3011
IF(V(K+1).EQ.990000.)GO TO 9020
3011 K=K-1
9020 W=ZZ
IF(V(K+3))K=K+3
C ABOVE IS FOR TYPED IN TEMPO CHANGES
KA=K+3
ZZ=V(KA)
C DUR OF NEXT TEMPI
X=V(KA+1)
Y=V(KA+2)
213 KA=0
Z=ZZ
CALL SQYY(YY,X,Y,Z)
CHN=CHN+W
XT(J)=X
IF(KA.EQ.1)Z=0
RA=PR
KA=0
K=K+3
GO TO 4020
END
SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
COMMON/VV/LIMIT, V(2000)
C TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
C KODES: -22=RHY -33=NOTES -44=NUMS -46=RLIST -36=RNOTES
C -11=SUBN -12=SUBR -55=MOVE NUMS -56=MOVE NOTES
C -66=DUPL -88=LIT -57=MOVE RANGE NUMS -58=MOVE RNG NOTES
DO 1 K=1,2000
N=V(K)
IF(N.LT.10000)GO TO 1
IF(N/10000.NE.INUM)GO TO 1
IF(MOD(N,10000).NE.IPAR)GO TO 1
ISTRT=K+4
KODE=V(K+2)
ICNT=V(K+3)
IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
RETURN
C FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
1 CONTINUE
END
SUBROUTINE NMCHG
DIMENSION RNAME(5),JNM(5)
COMMON /INS/ INST(27),BG(60)
COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
COMMON/VV/LIMIT, V(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL
1,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,RD,VIJ2
EQUIVALENCE (RNAME,JNM)
DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
DATA MM/"774000000000/
P(IPAR)=0
C REPLACE NAME BY A ZERO FOR THIS PARAM.
PL(IPAR)=1.
J=PM-1
C PM POINTS TO 1ST WORD OF LIT. STRING., PAR= LAST
N=V(J)
C THE WORD COUNT
DO 15 K=1,5
J=J+1
X=V(J)
IF(K.GT.N)X=' '
15 RNAME(K)=X
C N=WDCNT OF INST NAME
NN=0
DO 10 K=5,1,-1
NN=NN .OR. (JNM(K) .AND. MM)
IF (K-1) 20,20,17
17 IF (NN.GE.0)GO TO 13
NN = (( NN .AND. LL)/KK) .OR. JJ
GO TO 10
13 NN = NN / KK
10 CONTINUE
20 INST(INUM)=NN
END
C***** THIS ROUTINE DIVIDES OCTAVE INTO ANY NUMBER OF EQUAL PARTS
SUBROUTINE SUBR
COMMON /INS/ INST(27),BG(60)
COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
C CALL SUBROUTINE FROM P12. P3 CAN BE NOTES OR NUMBS.
X=P(3)
IF(PL(3).EQ.1)GO TO 1
IF(P(12).EQ.0)X=IFIX(X)
C FOR RAND NOTES TO PRINT OUT FREQS.
X=30.8677*2**(X/12)
C X=FREQ. IN HZ. BASED ON NOTE # IN P3.
PL(3)=1.
C THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.
1 P(3)=X*2**(P(11)/P(12))
C P12=# OF DIVISIONS OF THE OCTAVE. P11=CHROMATIC STEP IN THAT DIV.
RETURN
END
C STEPS ; TYPICAL INPUT FOR MICROTONE SUBROUTINE.
C CLAR /P2 .3/P3 A3/P4 1000;
C P11 NUM/0/1/2/3/4/5/6/7/8/9/FINE*;
C P12 9 SUBR/END; OCTAVE IS DIVIDED INTO 9 PARTS.